Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue56/Splat/recordmain.pas

Pascal/Delphi Source File | 2000-02-25 | 13.7 KB | 469 lines

unit RecordMain;

// Splat.
// Record a wave form for use in the Splat program.
// Copyright ⌐ 2000 Tempest Software, Inc.

interface

uses
  Windows, Messages, MMSystem, SysUtils, Classes, Graphics, Controls, Menus,
  Forms, Dialogs, ComCtrls, StdCtrls, ActnList, ImgList, WideLabel;

type
  EMciError = class(Exception)
  private
    fErrorCode: LongWord;
  public
    constructor Create(ErrorCode: LongWord); overload;
    constructor Create(ErrorCode: LongWord; const Msg: string); overload;
    constructor Create(ErrorCode: LongWord; const Fmt: string; const Args: array of const); overload;
    property ErrorCode: LongWord read fErrorCode;
  end;
  TSortColumn = (scName, scSize, scDate);
  TForm1 = class(TForm)
    Label1: TLabel;
    WaveList: TListView;
    StatusBar: TStatusBar;
    PopupMenu: TPopupMenu;
    ActionList: TActionList;
    PlayAction: TAction;
    DeleteAction: TAction;
    Play1: TMenuItem;
    Delete1: TMenuItem;
    ImageList: TImageList;
    ChDirAction: TAction;
    ChangeDirectory1: TMenuItem;
    N1: TMenuItem;
    ViewList1: TMenuItem;
    ViewDetails1: TMenuItem;
    Label2: TLabel;
    KeyboardList: TComboBox;
    Recording: TGroupBox;
    WideLabel1: TWideLabel;
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ActionListUpdate(Action: TBasicAction; var Handled: Boolean);
    procedure DeleteActionExecute(Sender: TObject);
    procedure PlayActionExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ChDirActionExecute(Sender: TObject);
    procedure ViewStyleExecute(Sender: TObject);
    procedure WaveListColumnClick(Sender: TObject; Column: TListColumn);
    procedure WaveListCompare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);
    procedure WaveListDeletion(Sender: TObject; Item: TListItem);
    procedure KeyboardListChange(Sender: TObject);
  private
    { Private declarations }
    RecordKey: Word;
    SortColumn: TSortColumn;
    SortAscending: Boolean;
    function AddWaveFile(const FileName: string; Size: Integer = 0;
      Date: TDateTime = 0): TListItem;
    procedure GetKeyboardLayouts;
    procedure GetWaveFiles;
    procedure SetMode(const Mode: string);
    procedure SetStatusInfo(const Info: WideString);
    procedure SetKeyDisplay(const Value: WideString);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses CommCtrl, FileCtrl, KeyText, ZWave;

{$R *.DFM}

resourcestring
  sRecording = 'Recording';
  sRecorded = 'Recorded %s';
  sCompressing = 'Compressing...';
  sKilo = 'KB';

const
  KiloBytes = 1024;

// Check a return code from an MCI function. Raise an exception for any error.
procedure MciCheck(ErrorCode: LongWord); overload;
begin
  if ErrorCode <> 0 then
    raise EMciError.Create(ErrorCode);
end;

// Check a return code from an MCI function. Raise an exception for any error.
// Use Msg as the exception message.
procedure MciCheck(ErrorCode: LongWord; const Msg: string); overload;
begin
  if ErrorCode <> 0 then
    raise EMciError.Create(ErrorCode, Msg);
end;

// Check a return code from an MCI function. Raise an exception for any error.
// Format an exception message from Fmt and Args.
procedure MciCheck(ErrorCode: LongWord; const Fmt: string; const Args: array of const); overload;
begin
  if ErrorCode <> 0 then
    raise EMciError.Create(ErrorCode, Fmt, Args);
end;

{ EMciError }
// Exception class for MCI errors.
constructor EMciError.Create(ErrorCode: LongWord);
begin
  Create(ErrorCode, '');
end;

constructor EMciError.Create(ErrorCode: LongWord; const Msg: string);
var
  Buffer: array[0..128] of Char;
begin
  fErrorCode := ErrorCode;
  MciGetErrorString(ErrorCode, Buffer, SizeOf(Buffer));
  inherited Create(Msg + Buffer);
end;

constructor EMciError.Create(ErrorCode: LongWord; const Fmt: string;
  const Args: array of const);
begin
  Create(ErrorCode, Format(Fmt, Args));
end;


{ TForm1 }

type
  // Keep basic information about each file as the associated data
  // in the list view.
  PFileInfo = ^TFileInfo;
  TFileInfo = record
    Size: Integer;
    Date: TDateTime;
  end;

// Add a file to the list view.
function TForm1.AddWaveFile(const FileName: string; Size: Integer; Date: TDateTime): TListItem;
var
  Search: TSearchRec;
  Info: PFileInfo;
begin
  Result := WaveList.Items.Add;
  Result.Caption := FileName;
  if (Size = 0) or (Date = 0) then
  begin
    if FindFirst(FileName, 0, Search) = 0 then
    begin
      Size := Search.Size;
      Date := FileDateToDateTime(Search.Time);
      FindClose(Search);
    end
  end;
  New(Info);
  Info.Size := Size;
  Info.Date := Date;
  Result.Data := Info;
  Result.SubItems.Add(IntToStr(Size div KiloBytes) + sKilo);
  Result.SubItems.Add(DateTimeToStr(Date));
end;

// Start recording a wave file for the key that the user has
// pressed. Record only the first key pressed until the user
// releases that key.
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
resourcestring
  sCannotOpen = 'Cannot open ZWAV recorder:'#13#10;
  sCannotRecord = 'Cannot record ZWAV file:'#13#10;
var
  DisplayText: WideString;
begin
  if RecordKey = 0 then
  begin
    // Not already recording a sound, so start recording.
    MciCheck(mciSendString('open new type waveaudio alias wave', nil, 0, 0), sCannotOpen);
    MciCheck(mciSendString('record wave', nil, 0, 0), sCannotRecord);

    // Remember which key is being recorded, and update the status bar.
    RecordKey := Key;
    SetMode(sRecording);
    DisplayText := KeyCodeToDisplay(Key);
    SetStatusInfo(DisplayText);
    SetKeyDisplay(DisplayText);
  end;
end;

// Stop recording when the user releases the key. Make sure
// the user is releasing the key that is being recorded (in case
// the user presses multiple keys).
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
resourcestring
  sCannotStop = 'Cannot stop recording ZWAV file:'#13#10;
  sCannotSave = 'Cannot save ZWAV file (%s):'#13#10;
  sCannotClose = 'Cannot close ZWAV recorder:'#13#10;
var
  FileName, ZFileName: string;
  Item: TListItem;
begin
  if Key = RecordKey then
  begin
    MciCheck(mciSendString('stop wave', nil, 0, 0), sCannotStop);

    // Save the waveform to a file.
    FileName := KeyCodeToText(RecordKey) + '.wav';
    MciCheck(mciSendString(PChar('save wave ' + FileName), nil, 0, 0),
             Format(sCannotSave, [FileName]));

    MciCheck(mciSendString('close wave', nil, 0, 0), sCannotClose);

    SetMode(sCompressing);
    ZFileName := KeyCodeToText(RecordKey) + '.zwav';
    Compress(FileName, ZFileName);
    DeleteFile(FileName);
    FileName := ZFileName;

    RecordKey := 0;
    SetMode('');
    SetKeyDisplay('');
    SetStatusInfo(Format(sRecorded, [FileName]));

    // If the file is not already in the list, add it.
    Item := WaveList.FindCaption(0, FileName, False, True, True);
    if Item = nil then
      Item := AddWaveFile(FileName);
    Item.Selected := True;
  end;
end;

// Set the status mode in the left-hand panel of the status bar.
procedure TForm1.SetMode(const Mode: string);
begin
  StatusBar.Panels[0].Text := Mode;
end;

// Set the status information in the right-hand panel of the status bar.
procedure TForm1.SetStatusInfo(const Info: WideString);
begin
  // Do the following: "StatusBar.Panels[1].Text := Info;"
  // but using Unicode
  SendMessageW(StatusBar.Handle, Sb_SetTextW, 1, LParam(PWideChar(Info)));
end;

// Enable or disable actions according to the list view selection.
// Only one file can be played at a time, so enable the Play action
// only when exactly one file is selected.
// Enable Delete when one or more files is selected.
procedure TForm1.ActionListUpdate(Action: TBasicAction; var Handled: Boolean);
begin
  PlayAction.Enabled := WaveList.SelCount = 1;
  DeleteAction.Enabled := WaveList.SelCount > 0;
end;

// Delete the selected file or files. Confirm the deletion with the user first.
// If one file is selected, show the file name in the prompt. Otherwise,
// just show the number of files to be deleted.
procedure TForm1.DeleteActionExecute(Sender: TObject);
resourcestring
  sConfirmOne = 'Are you sure you want to delete %s?';
  sDeletedOne = '%s deleted';
  sConfirmMany = 'Are you sure you want to delete the selected files?';
  sDeletedMany = '%d files deleted';
var
  FileName: string;
  Count, I: Integer;
begin
  Assert(WaveList.Selected <> nil);
  if WaveList.SelCount = 1 then
  begin
    FileName := WaveList.Selected.Caption;
    if mrYes = MessageDlg(Format(sConfirmOne, [FileName]), mtConfirmation, [mbYes, mbNo], 0) then
    begin
      WaveList.Selected.Delete;
      DeleteFile(FileName);
      SetStatusInfo(Format(sDeletedOne, [FileName]));
    end;
  end
  else if mrYes = MessageDlg(sConfirmMany, mtConfirmation, [mbYes, mbNo], 0) then
  begin
    Count := 0;
    for I := WaveList.Items.Count-1 downto 0 do
    begin
      if WaveList.Items[I].Selected then
      begin
        FileName := WaveList.Items[I].Caption;
        WaveList.Items[I].Delete;
        if DeleteFile(FileName) then
          Inc(Count);
      end;
    end;
    SetStatusInfo(Format(sDeletedMany, [Count]));
  end;
end;

// Play the selected file.
procedure TForm1.PlayActionExecute(Sender: TObject);
begin
  if WaveList.Selected <> nil then
    Win32Check(PlayCompressedSound(PChar(WaveList.Selected.Caption), 0, Snd_FileName or Snd_NoDefault or Snd_Async));
  SetStatusInfo('');
end;

// Load all the keyboard layouts that the user has installed.
// The user can select a new keyboard layout at runtime.
procedure TForm1.GetKeyboardLayouts;
var
  I: Integer;
  Index: Integer;
  Handle: HKL;
begin
  for I := 0 to Languages.Count-1 do
  begin
    Handle := LoadKeyboardLayout(PChar(IntToHex(Languages.LocaleID[I], 8)), Klf_Substitute_OK or Klf_NoTellShell);
    if Handle <> 0 then
    begin
      Index := KeyboardList.Items.AddObject(Languages.Name[I], TObject(Handle));
      // Pre-select the current keyboard layout.
      if Handle = GetKeyboardLayout(0) then
        KeyboardList.ItemIndex := Index;
    end;
  end;
end;

// Start the program by fetching all the .ZWAV files in the current directory.
procedure TForm1.FormCreate(Sender: TObject);
begin
  GetWaveFiles;
  GetKeyboardLayouts;
end;

// Get all the .ZWAV files in the current directory and show them
// in the list view.
procedure TForm1.GetWaveFiles;
resourcestring
  sCaption = 'Record Sounds - ';
var
  Search: TSearchRec;
begin
  WaveList.Items.BeginUpdate;
  try
    // Add the directory name to the form and application captions.
    Caption := sCaption + GetCurrentDir;
    Application.Title := Caption;
    WaveList.Items.Clear;
    if FindFirst('*.zwav', faAnyFile, Search) = 0 then
      try
        repeat
          if (Search.Attr and faDirectory) = 0 then
            AddWaveFile(Search.Name, Search.Size, FileDateToDateTime(Search.Time));
        until FindNext(Search) <> 0;
      finally
        FindClose(Search);
      end;
  finally
    WaveList.Items.EndUpdate;
  end;
end;

// Change directories and get the .ZWAV files in the new directory.
procedure TForm1.ChDirActionExecute(Sender: TObject);
resourcestring
  sDlgCaption = 'Select folder for ZWAV files';
var
  Dir: string;
begin
  if SelectDirectory(sDlgCaption, '', Dir) then
  begin
    if not SysUtils.SetCurrentDir(Dir) then
      RaiseLastWin32Error;
    GetWaveFiles;
  end;
end;

// Change the list view style.
procedure TForm1.ViewStyleExecute(Sender: TObject);
begin
  WaveList.ViewStyle := TViewStyle((Sender as TComponent).Tag);
  (Sender as TMenuItem).Checked := True;
end;

// Change the sort order of the list view.
procedure TForm1.WaveListColumnClick(Sender: TObject; Column: TListColumn);
begin
  if SortColumn = TSortColumn(Column.Tag) then
    SortAscending := not SortAscending
  else
  begin
    SortColumn := TSortColumn(Column.Tag);
    SortAscending := True;
  end;
  WaveList.AlphaSort;
end;

procedure TForm1.WaveListCompare(Sender: TObject; Item1, Item2: TListItem;
  Data: Integer; var Compare: Integer);
resourcestring
  sCannotHappen = 'WaveListCompare: internal error, SortColumn=%d';
var
  Info1, Info2: PFileInfo;
begin
  Info1 := Item1.Data;
  Info2 := Item2.Data;
  Assert(Info1 <> nil);
  Assert(Info2 <> nil);
  case SortColumn of
  scName:
    Compare := AnsiCompareFileName(Item1.Caption, Item2.Caption);
  scSize:
    Compare := Info1.Size - Info2.Size;
  scDate:
    if Info1.Date > Info2.Date then
      Compare := 1
    else if Info1.Date < Info2.Date then
      Compare := -1
    else
      Compare := 0;
  else
    raise Exception.CreateFmt(sCannotHappen, [Ord(SortColumn)]);
  end;

  if not SortAscending then
    Compare := -Compare;
end;

// When a list view item is removed from the list view,
// delete the associated data record.
procedure TForm1.WaveListDeletion(Sender: TObject; Item: TListItem);
begin
  FreeMem(Item.Data);
end;

// When the user selects a new keyboard, tell Windows
// to activate that keyboard layout.
procedure TForm1.KeyboardListChange(Sender: TObject);
var
  Handle: HKL;
begin
  if KeyboardList.ItemIndex >= 0 then
  begin
    Handle := HKL(KeyboardList.Items.Objects[KeyboardList.ItemIndex]);
    Win32Check(ActivateKeyboardLayout(Handle, 0) <> 0);
  end;
end;

const
  Margin = 8;

// Set the text for the key display.
procedure TForm1.SetKeyDisplay(const Value: WideString);
begin
  WideLabel1.Caption := Value;
end;

end.